home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / pcboard / auct106.zip / AUCTION.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1996-10-24  |  16KB  |  657 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Boolean  BOOLEAN001
  20.     Integer  INTEGER001
  21.     Integer  INTEGER002
  22.     Integer  INTEGER003
  23.     Integer  INTEGER004
  24.     Integer  INTEGER005
  25.     Integer  INTEGER006
  26.     Integer  INTEGER007
  27.     Integer  INTEGER008
  28.     Integer  INTEGER009
  29.     Integer  INTEGER010
  30.     Integer  INTEGER011
  31.     Integer  INTEGER012
  32.     Integer  TINTEGER013(99)
  33.     String   STRING001
  34.     String   STRING002
  35.     String   STRING003
  36.     String   STRING004
  37.     String   STRING005
  38.     String   STRING006
  39.     String   TSTRING007(10)
  40.     String   STRING008
  41.     String   STRING009
  42.     String   STRING010
  43.     String   STRING011
  44.     String   STRING012
  45.     String   STRING013
  46.     String   STRING014
  47.     String   STRING015
  48.     String   STRING016
  49.     String   STRING017
  50.     String   STRING018
  51.     String   STRING019
  52.     String   TSTRING020(3)
  53.     String   STRING021
  54.     Declare  Procedure PROC001()
  55.     Declare  Procedure PROC002()
  56.     Declare  Procedure PROC003()
  57.  
  58. ;------------------------------------------------------------------------------
  59.  
  60.     Goto LABEL001
  61.     End
  62.     If (0 == 0) STRING001 = "NO"
  63.     If (0 == 1) STRING001 = "YES"
  64.  
  65.     EndFunc
  66.  
  67.     :LABEL001
  68.     STRING018 = "1.06"
  69.     INTEGER006 = 1
  70.     STRING012 = "@X0C!!! SOLD !!!   !!! SOLD   !!!@X0F"
  71.     STRING008 = String(PcbNode())
  72.     If (PcbNode() == 0) STRING008 = "A"
  73.     STRING009 = String(Random(1000)) + "X" + STRING008
  74.     DOpen 0, PPEPath() + "AUCTION.DBF", 0
  75.     DnCreate 0, PPEPath() + STRING009 + ".NDX", "ITEM_DESC"
  76.     DTop 0
  77.     If (Exist(PPEPath() + "UNIVERSL.KEY")) Then
  78.         PROC001()
  79.     ElseIf (Exist(PPEPath() + "UNI.KEY")) Then
  80.         PROC002()
  81.     Else
  82.         If (Exist(PPEPath() + "AUCTION.KEY")) Goto LABEL002
  83.         BOOLEAN001 = 0
  84.         Goto LABEL003
  85.         :LABEL002
  86.         FOpen 2, PPEPath() + "AUCTION.KEY", 0, 0
  87.         FGet 2, STRING013
  88.         FGet 2, STRING014
  89.         FGet 2, STRING015
  90.         FClose 2
  91.         If (Strip(Left(Upper(ReadLine(PCBDat(), 94)), 8), " ") <> "The TAO BBS") Then
  92.             If (Strip(Left(Upper(STRING014), 3), " ") <> Strip(Left(Upper(ReadLine(PCBDat(), 94)), 3), " ")) Then
  93.                 STRING021 = "BBS Name does *NOT* match keyfile"
  94.                 Goto LABEL012
  95.             Endif
  96.         Endif
  97.         STRING016 = Mid(STRING013, 2, 1)
  98.         STRING017 = Mid(STRING014, 5, 1)
  99.         STRING016 = Abs(Asc(STRING016) + 56 - 100)
  100.         STRING017 = Abs(Asc(STRING017) + 56 - 100)
  101.         If ((ToInteger(Mid(STRING015, 1, 2)) == ToInteger(Left(STRING016, 2))) && (ToInteger(Mid(STRING015, 79, 2)) == ToInteger(Left(STRING017, 2)))) Then
  102.             BOOLEAN001 = 1
  103.         Endif
  104.     Endif
  105.     :LABEL003
  106.     If (BOOLEAN001 == 1) Then
  107.         Cls
  108.         PrintLn "@X1C░▒▓█ @X1ESilent Auction v", STRING018, " @X1C█▓▒░             @X1F(c)1996 Practical Computer Services@X0F"
  109.         Newlines 2
  110.         PrintLn "@X0ERegistered to:@X0D ", STRING014
  111.         PrintLn "       @X0E SysOp:@X0D ", STRING013, "@X0F"
  112.         Delay (1 * 182) / 10
  113.     Else
  114.         Cls
  115.         For INTEGER007 = 1 To 10
  116.             PrintLn "@X0EThis is @X8CUNREGISTERED @X0Esoftware - Please encourage your SysOp to register it!@X0F"
  117.             PrintLn "                     @X0APractical Computer Services Silent Auction@X0F"
  118.             Delay (1 * 182) / 10
  119.             If (INTEGER007 == 10) Delay 2 * 182 / 10
  120.         Next
  121.     Endif
  122.     DTop 0
  123.     If (DGet(0, "FINAL_DATE") == ToInteger(Date())) Goto LABEL004
  124.     DPut 0, "FINAL_DATE", ToInteger(Date())
  125.     DTop 0
  126.     If (DRecCount(0) == 1) Goto LABEL004
  127.     For INTEGER005 = 1 To DRecCount(0)
  128.         DSkip 0, 1
  129.         If (ToInteger(Date()) >= DGet(0, "FINAL_DATE") + 10) Then
  130.             DBlank 0
  131.             DDelete 0
  132.         Endif
  133.         If (ToInteger(Date()) >= DGet(0, "FINAL_DATE")) Then
  134.             DPut 0, "FINAL_DATE", 999999
  135.             DPut 0, "DESC_1", STRING012 + DGet(0, "DESC_1")
  136.             Backup 80
  137.             ClrEol
  138.             PrintLn "@X0EOne Moment...Sending out notifications...@X0F"
  139.             Gosub LABEL010
  140.         Endif
  141.     Next
  142.     DPack 0
  143.     :LABEL004
  144.     If (Exist(PPEPath() + "SCREEN1.DSP")) DispFile PPEPath() + "SCREEN1.DSP", 0
  145.     If (Exist(PPEPath() + "SCREEN2.DSP")) DispFile PPEPath() + "SCREEN2.DSP", 0
  146.     If (Exist(PPEPath() + "SCREEN3.DSP")) DispFile PPEPath() + "SCREEN3.DSP", 0
  147.     If (Exist(PPEPath() + "SCREEN4.DSP")) DispFile PPEPath() + "SCREEN4.DSP", 0
  148.     :LABEL005
  149.     Cls
  150.     PrintLn "@POS:1@@X1A■■@X1E Initializing Silent Auction @X1A■■@X1E                      ", "Total Records = @X1C", DRecCount(0) - 1, "@POS:79@@X0F"
  151.     Delay (1 * 182) / 10
  152.     :LABEL006
  153.     Cls
  154.     PrintLn "@X10┌─────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  155.     PrintLn "@X10│ @X1A░▒▓█ @X9ESilent Auction! v", STRING018, " @X1A█▓▒░        @X1F(c)1996 @X1EPractical Computer Services @X1F @POS:79@@X19│@X0F"
  156.     PrintLn "@X10└@X19─────────────────────────────────────────────────────────────────────────────┘@X0F"
  157.     PrintLn "@X10┌─────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  158.     DGo 0, INTEGER006
  159.     INTEGER001 = 0
  160.     :LABEL007
  161.     Inc INTEGER001
  162.     If (!DEof(0)) DSkip 0, 1
  163.     If (Trim(DGet(0, "CURR_BID"), " ") == "000") Then
  164.         If (!DEof(0)) PrintLn "@X10│ @X1A", DRecNo(0) - 1, "@X1E)@X1B ", Left(Trim(DGet(0, "ITEM_DESC"), " "), 63) , "@POS:70@@X1E$@X1A", Trim(DGet(0, "MIN_BID"), " ") , "@POS:79@@X19│@X0F"
  165.     Else
  166.         If (!DEof(0)) PrintLn "@X10│@X1A ", DRecNo(0) - 1, "@X1E)@X1B ", Left(Trim(DGet(0, "ITEM_DESC"), " "), 63) , "@POS:70@@X1E$@X1A", Trim(DGet(0, "CURR_BID"), " ") , "@POS:79@@X19│@X0F"
  167.     Endif
  168.     If (INTEGER001 == 15) Gosub LABEL008
  169.     If (!DEof(0)) Goto LABEL007
  170.     :LABEL008
  171.     INTEGER006 = INTEGER006 + INTEGER001
  172.     If (INTEGER006 > DRecCount(0)) INTEGER006 = 1
  173.     PrintLn "@X10└@X19─────────────────────────────────────────────────────────────────────────────┘@X0F"
  174.     PrintLn 
  175.     If (DRecCount(0) - 1 == 0) Then
  176.         Print " @X0AYou're the first! @X0E(@X0CQ@X0E)@X0Cuit @X0E(@X0DA@X0E)@X0Ddd an auction item@X0F "
  177.     Else
  178.         If (INTEGER001 == 15) Then
  179.             Print "  @X0AItem @X0B#@X0A to View @X0E(@X0B1 @X0E-@X0B ", DRecCount(0) - 1, "@X0E) (@X0CQ@X0E)@X0Cuit @X0E(@X0DA@X0E)@X0Ddd @X0E(@X0AM@X0E)@X0Aore @X0E(@X0AR@X0E)@X0Aemove@X0F "
  180.             INTEGER001 = 0
  181.         Endif
  182.         If (INTEGER001 <> 0) Then
  183.             Print "  @X0AItem @X0B#@X0A to View @X0E(@X0B1 @X0E-@X0B ", DRecCount(0) - 1, "@X0E) (@X0CQ@X0E)@X0Cuit @X0E(@X0DA@X0E)@X0Ddd @X0E(@X0AM@X0E)@X0Aore @X0E(@X0AR@X0E)@X0Aemove@X0F "
  184.             INTEGER001 = 0
  185.         Endif
  186.         STRING002 = ""
  187.     Endif
  188.     InputStr "_", STRING002, 11, 3, "1234567890QARMB", 0 + 8
  189.     If (((STRING002 == "0") || (STRING002 == "")) || (STRING002 == "M")) Goto LABEL006
  190.     If (ToInteger(STRING002) > DRecCount(0) - 1) Goto LABEL006
  191.     If (STRING002 == "Q") Goto LABEL013
  192.     If (STRING002 == "A") Goto LABEL009
  193.     If (STRING002 == "B") Then
  194.         PROC003()
  195.         Goto LABEL006
  196.     Endif
  197.     If (STRING002 == "R") Then
  198.         Backup 80
  199.         ClrEol
  200.         STRING002 = ""
  201.         InputStr "@X0E  Which @X0C# @X0Eto remove @X0A(@X02Must be yours@X0A) _", STRING002, 11, 3, Mask_Num(), 0
  202.     Else
  203.         DGo 0, ToInteger(STRING002) + 1
  204.         Cls
  205.         If (CurSec() >= SysopSec()) Then
  206.             Print "Seller Name :@X03 ", Trim(DGet(0, "NAME"), " ")
  207.             If (Len(Trim(DGet(0, "HBN"), " ")) <> 0) Then
  208.                 PrintLn "@POS:50@@X0BHigh Bidder :@X03 ", Trim(DGet(0, "HBN"), " ")
  209.             Else
  210.                 PrintLn "@POS:50@@X0BHigh Bidder :@X03 None"
  211.             Endif
  212.             PrintLn 
  213.         Else
  214.             Newlines 2
  215.         Endif
  216.         If (Trim(DGet(0, "NAME"), " ") == U_Name()) Then
  217.             Print "Seller Name :@X03 ", Trim(DGet(0, "NAME"), " ")
  218.             If (Len(Trim(DGet(0, "HBN"), " ")) <> 0) Then
  219.                 PrintLn "@POS:50@@X0BHigh Bidder :@X03 ", Trim(DGet(0, "HBN"), " ")
  220.             Else
  221.                 PrintLn "@POS:50@@X0BHigh Bidder :@X03 None"
  222.             Endif
  223.             PrintLn 
  224.         Else
  225.             Newlines 2
  226.         Endif
  227.         PrintLn "Item: @X0C", DGet(0, "ITEM_DESC")
  228.         PrintLn "@X01───────────────────────────────────────────────────────────────────────────────@X0F"
  229.         If (Trim(DGet(0, "CURR_BID"), " ") == "000") Then
  230.             PrintLn "@X0EMinimum Bid: @X0A", DGet(0, "MIN_BID"), "@POS:30@@X0EBid Increment:@X0A ", DGet(0, "BID_INC"), "@X0E@POS:50@# of Bids:@X0A ", Trim(DGet(0, "NUM_BIDS"), " ")
  231.         Else
  232.             PrintLn "@X0ECurrent Bid: @X0A", DGet(0, "CURR_BID"), "@X0E@POS:30@Bid Increment:@X0A ", DGet(0, "BID_INC"), "@POS:50@@X0E# of Bids:@X0A ", Trim(DGet(0, "NUM_BIDS"), " ")
  233.         Endif
  234.         PrintLn "@X01───────────────────────────────────────────────────────────────────────────────@X0F"
  235.         PrintLn 
  236.         PrintLn "@X10┌─────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  237.         PrintLn "@X10│@X1A ", DGet(0, "DESC_1"), "@POS:79@@X19│@X0F"
  238.         If (Len(Trim(DGet(0, "DESC_2"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_2") , "@POS:79@@X19│@X0F"
  239.         If (Len(Trim(DGet(0, "DESC_3"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_3") , "@POS:79@@X19│@X0F"
  240.         If (Len(Trim(DGet(0, "DESC_4"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_4") , "@POS:79@@X19│@X0F"
  241.         If (Len(Trim(DGet(0, "DESC_5"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_5") , "@POS:79@@X19│@X0F"
  242.         If (Len(Trim(DGet(0, "DESC_6"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_6") , "@POS:79@@X19│@X0F"
  243.         If (Len(Trim(DGet(0, "DESC_7"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_7") , "@POS:79@@X19│@X0F"
  244.         If (Len(Trim(DGet(0, "DESC_8"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_8") , "@POS:79@@X19│@X0F"
  245.         If (Len(Trim(DGet(0, "DESC_9"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_9") , "@POS:79@@X19│@X0F"
  246.         If (Len(Trim(DGet(0, "DESC_10"), " ")) <> 0) PrintLn "@X10│@X1A ", DGet(0, "DESC_10") , "@POS:79@@X19│@X0F"
  247.         PrintLn "@X10└@X19─────────────────────────────────────────────────────────────────────────────┘@X0F"
  248.         InputStr "Would you like to bid on this item (Y/N) _", STRING002, 14, 1, "YN", 0 + 8
  249.         If ((STRING002 == "") || (STRING002 == "N")) Goto LABEL006
  250.         Backup 80
  251.         ClrEol
  252.         If (Trim(DGet(0, "CURR_BID"), " ") == "000") Then
  253.             Print "Current Bid is @X0A$ ", ToInteger(DGet(0, "MIN_BID")), "@POS:25@@X0E Your Bid $@X02 "
  254.         Else
  255.             Print "@X0ECurrent Bid is @X0A$ ", ToInteger(DGet(0, "CURR_BID") + ToInteger(DGet(0, "BID_INC"))), "@POS:25@@X0E Your Bid $@X02 "
  256.         Endif
  257.         InputStr "_", STRING002, 11, 8, "1234567890Q.", 0 + 8
  258.         If (Trim(DGet(0, "CURR_BID"), " ") == "000") Then
  259.             If (ToInteger(STRING002) < ToInteger(DGet(0, "MIN_BID")) + ToInteger(DGet(0, "BID_INC"))) Then
  260.                 Backup 80
  261.                 ClrEol
  262.                 PrintLn "@X0CSorry, but your bid was too @X8Clow@X0C, others have bid @X8Fmore@X0C, Your bid is discarded!@X0F"
  263.                 Delay (5 * 182) / 10
  264.                 Goto LABEL006
  265.             Endif
  266.         ElseIf (ToInteger(STRING002) < ToInteger(DGet(0, "CURR_BID")) + ToInteger(DGet(0, "BID_INC"))) Then
  267.             Backup 80
  268.             ClrEol
  269.             PrintLn "@X0CSorry, but your bid was too @X8Clow@X0C, others have bid @X8Fmore@X0C, Your bid @X8Cdiscarded@X0C!@X0F"
  270.             Delay (5 * 182) / 10
  271.             Goto LABEL006
  272.         Endif
  273.         DGet 0, "CURR_BID", INTEGER003
  274.         DGet 0, "BID2", INTEGER004
  275.         DGet 0, "HBN", STRING010
  276.         DGet 0, "BN2", STRING011
  277.         DPut 0, "CURR_BID", ToInteger(STRING002)
  278.         DPut 0, "BID2", INTEGER003
  279.         DPut 0, "BID3", INTEGER004
  280.         DPut 0, "HBN", U_Name()
  281.         DPut 0, "BN2", STRING010
  282.         DPut 0, "BN3", STRING011
  283.         DPut 0, "BUY_NUM", ""
  284.         DPut 0, "NUM_BIDS", DGet(0, "NUM_BIDS") + 1
  285.         Goto LABEL006
  286.         :LABEL009
  287.         STRING002 = ""
  288.         Cls
  289.         Newlines 3
  290.         PrintLn "@X0APlease enter a @X0E63@X0A character description of your Auction item @X09──@X0E(@X0CQ@X0E)@X0Cuit@X09─────┐"
  291.         Print "                                                               ──────────┘@X0F"
  292.         Backup 80
  293.         InputStr "_", STRING003, 10, 63, Mask_Ascii(), 0
  294.         If (Upper(STRING003) == "Q") Goto LABEL006
  295.         Newlines 2
  296.         InputStr "Please enter the mimimum bid you will accept $ _", STRING004, 11, 8, "." + Mask_Num(), 0
  297.         Newlines 2
  298.         InputStr "Please enter the bid increment you desire for this auction item $ _", STRING006, 11, 8, "." + Mask_Num(), 0
  299.         Newlines 2
  300.         InputStr "Please enter how many days you want this auction item up for bid _", STRING005, 11, 3, Mask_Num(), 0
  301.         Cls
  302.         Newlines 2
  303.         PrintLn "@X0AItem :@X0B ", STRING003
  304.         PrintLn 
  305.         PrintLn "@X0AMinimum Bid @X0E:@X0B ", STRING004, "@X0A@POS:25@Bid Increment @X0E:@X0B ", STRING006, "@POS:50@@X0ADays for Bid @X0E:@X0B ", STRING005
  306.         Newline
  307.         PrintLn "@X0APlease enter a full description of your auction item, you have 10 lines"
  308.         PrintLn "to fully convey the essence of your product.  To abort, type a @X0CQ @X0Aby itself"
  309.         PrintLn "on a blank line, or to @X0Fsave@X0A type an @X0ES@X0A.@X0F"
  310.         PrintLn "@X01────────────────────────────────────────────────────────────────────────────@X0F"
  311.         For INTEGER002 = 1 To 10
  312.             InputStr "_", TSTRING007(INTEGER002), 11, 75, Mask_Ascii(), 0 + 64
  313.             If (Upper(TSTRING007(INTEGER002)) == "Q") Then
  314.                 For INTEGER002 = 1 To 10
  315.                     TSTRING007(INTEGER002) = ""
  316.                 Next
  317.                 Goto LABEL005
  318.             Endif
  319.             If (Upper(TSTRING007(INTEGER002)) == "S") Then
  320.                 TSTRING007(INTEGER002) = ""
  321.                 Break
  322.             Endif
  323.         Next
  324.         DNew 0
  325.         DPut 0, "NAME", U_Name()
  326.         DPut 0, "MIN_BID", STRING004
  327.         DPut 0, "CURR_BID", "000"
  328.         DPut 0, "FINAL_DATE", ToInteger(Date()) + STRING005
  329.         DPut 0, "BID_INC", STRING006
  330.         DPut 0, "CAT_CODE", "Z"
  331.         DPut 0, "ITEM_DESC", STRING003
  332.         DPut 0, "NUM_BIDS", "0"
  333.         DPut 0, "DESC_1", TSTRING007(1)
  334.         DPut 0, "DESC_2", TSTRING007(2)
  335.         DPut 0, "DESC_3", TSTRING007(3)
  336.         DPut 0, "DESC_4", TSTRING007(4)
  337.         DPut 0, "DESC_5", TSTRING007(5)
  338.         DPut 0, "DESC_6", TSTRING007(6)
  339.         DPut 0, "DESC_7", TSTRING007(7)
  340.         DPut 0, "DESC_8", TSTRING007(8)
  341.         DPut 0, "DESC_9", TSTRING007(9)
  342.         DPut 0, "DESC_10", TSTRING007(10)
  343.         DPut 0, "DELETE", "N"
  344.         DAdd 0
  345.         Goto LABEL006
  346.     Endif
  347.     DGo 0, ToInteger(STRING002) + 1
  348.     If ((Trim(DGet(0, "NAME"), " ") <> U_Name()) && (CurSec() <> SysopSec())) Then
  349.         Backup 80
  350.         ClrEol
  351.         PrintLn "  @X0CThat is not your item to delete.@X0F"
  352.         Delay (3 * 182) / 10
  353.         Goto LABEL006
  354.     Endif
  355.     DDelete 0
  356.     DPack 0
  357.     Goto LABEL006
  358.     :LABEL010
  359.     If (DRecNo(0) == 1) Return
  360.     If (DGet(0, "CURR_BID") < 1) Goto LABEL011
  361.     FOpen 1, PPEPath() + String(PcbNode()) + ".MSG", 2, 0
  362.     FPutLn 1, "Notice from the Auctioneer!"
  363.     FPutLn 1, "---------------------------"
  364.     FPutLn 1, "Item: ", Trim(DGet(0, "ITEM_DESC"), " ")
  365.     FPutLn 1, "---------------------------"
  366.     FPutLn 1, "The bid date on your auctioned item has expired. The item"
  367.     FPutLn 1, "has been bid on and won by ", Trim(Mixed(DGet(0, "HBN")), " "), " for a high bid of $", Trim(DGet(0, "CURR_BID"), " ")
  368.     FPutLn 1
  369.     FPutLn 1, "Notification has been sent to ", Trim(Mixed(DGet(0, "HBN")), " "), ", you also may want"
  370.     FPutLn 1, "to leave them a message to work out the details of the sale."
  371.     FPutLn 1
  372.     FPutLn 1, "Thank you for using The Auctioneer!"
  373.     FPutLn 1
  374.     FPutLn 1
  375.     FClose 1
  376.     Message 0, Trim(DGet(0, "NAME"), " "), "The Auctioneer!", "Auction Time Expired!", "R", "0", 0, 0, PPEPath() + String(PcbNode()) + ".MSG"
  377.     Delete PPEPath() + String(PcbNode()) + ".MSG"
  378.     FOpen 1, PPEPath() + String(PcbNode()) + ".MSG", 2, 0
  379.     FPutLn 1, "Notice from the Auctioneer!"
  380.     FPutLn 1, "---------------------------"
  381.     FPutLn 1, "Item: ", Trim(DGet(0, "ITEM_DESC"), " ")
  382.     FPutLn 1, "---------------------------"
  383.     FPutLn 1, "Your bid on the above auctioned item has been accepted."
  384.     FPutLn 1, "You bid a total of $", Trim(DGet(0, "CURR_BID"), " "), "."
  385.     FPutLn 1
  386.     FPutLn 1, "Notification has been sent to ", Trim(Mixed(DGet(0, "NAME")), " "), ", you also may want"
  387.     FPutLn 1, "to leave them a message to work out the details of the sale."
  388.     FPutLn 1
  389.     FPutLn 1, "Thank you for using The Auctioneer!"
  390.     FPutLn 1
  391.     FPutLn 1
  392.     FClose 1
  393.     Message 0, Trim(DGet(0, "HBN"), " "), "The Auctioneer!", "Auction Time Expired!", "R", "0", 0, 0, PPEPath() + String(PcbNode()) + ".MSG"
  394.     Delete PPEPath() + String(PcbNode()) + ".MSG"
  395.     Return
  396.     :LABEL011
  397.     FOpen 1, PPEPath() + String(PcbNode()) + ".MSG", 2, 0
  398.     FPutLn 1, "Notice from the Auctioneer!"
  399.     FPutLn 1, "---------------------------"
  400.     FPutLn 1, "Item: ", Trim(DGet(0, "ITEM_DESC"), " ")
  401.     FPutLn 1, "---------------------------"
  402.     FPutLn 1, "The bid date on your auctioned item has expired. The item"
  403.     FPutLn 1, "has *NOT* been bid on."
  404.     FPutLn 1
  405.     FPutLn 1, "You may want to change your asking price and/or the description"
  406.     FPutLn 1, "of the item to make it more attractive to people."
  407.     FPutLn 1
  408.     FPutLn 1, "Thank you for using The Auctioneer!"
  409.     FPutLn 1
  410.     FPutLn 1
  411.     FClose 1
  412.     Message 0, Trim(DGet(0, "NAME"), " "), "The Auctioneer!", "Auction Time Expired!", "R", "0", 0, 0, PPEPath() + String(PcbNode()) + ".MSG"
  413.     Delete PPEPath() + String(PcbNode()) + ".MSG"
  414.     Return
  415.     :LABEL012
  416.     Cls
  417.     Newlines 2
  418.     PrintLn "@X10┌─────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  419.     PrintLn "@X10│@X9C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @X19│@X0F"
  420.     PrintLn "@X10│@X9C !!!!!                                                                 !!!!! @X19│@X0F"
  421.     PrintLn "@X10│@X9C !!!!! @X1E Your BBS name does NOT match the name compiled into the        @X9C!!!!! @X19│@X0F"
  422.     PrintLn "@X10│@X9C !!!!! @X1E AUCTION.KEY file. The name in the key file MUST be EXACTLY     @X9C!!!!! @X19│@X0F"
  423.     PrintLn "@X10│@X9C !!!!! @X1E the same as configured in PCBSETUP. This key is useless!       @X9C!!!!! @X19│@X0F"
  424.     PrintLn "@X10│@X9C !!!!!                                                                 !!!!! @X19│@X0F"
  425.     PrintLn "@X10│@X9C !!!!! @X1E Decompilation of copyrighted works is a U.S. Federal           @X9C!!!!! @X19│@X0F"
  426.     PrintLn "@X10│@X9C !!!!! @X1E crime, and punishable by up to 10 years in prison and          @X9C!!!!! @X19│@X0F"
  427.     PrintLn "@X10│@X9C !!!!! @X1E a $100,000 fine.                                               @X9C!!!!! @X19│@X0F"
  428.     PrintLn "@X10│@X9C !!!!!                                                                 !!!!! @X19│@X0F"
  429.     PrintLn "@X10│@X9C !!!!! @X1E Support shareware! This is how we put food on our tables       @X9C!!!!! @X19│@X0F"
  430.     PrintLn "@X10│@X9C !!!!! @X1E and clothes on our childrens backs.  Thank you!                @X9C!!!!! @X19│@X0F"
  431.     PrintLn "@X10│@X9C !!!!!                                                                 !!!!! @X19│@X0F"
  432.     PrintLn "@X10│@X9C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @X19│@X0F"
  433.     PrintLn "@X10└@X19─────────────────────────────────────────────────────────────────────────────┘@X0F"
  434.     PrintLn STRING021
  435.     Delay 1000
  436.     DCloseAll
  437.     Delete PPEPath() + STRING009 + ".NDX"
  438.     End
  439.     :LABEL013
  440.     DCloseAll
  441.     Delete PPEPath() + STRING009 + ".NDX"
  442.     If (Exist(PPEPath() + "SCRN1.DSP")) DispFile PPEPath() + "SCRN1.DSP", 0
  443.     If (Exist(PPEPath() + "SCRN2.DSP")) DispFile PPEPath() + "SCRN2.DSP", 0
  444.     If (Exist(PPEPath() + "SCRN3.DSP")) DispFile PPEPath() + "SCRN3.DSP", 0
  445.     If (Exist(PPEPath() + "SCRN4.DSP")) DispFile PPEPath() + "SCRN4.DSP", 0
  446.     End
  447.  
  448. ;------------------------------------------------------------------------------
  449.  
  450.     Procedure PROC001()
  451.  
  452.     FOpen 1, PPEPath() + "UNIVERSL.KEY", 0, 0
  453.     FDefIn 1
  454.     For INTEGER011 = 1 To 3
  455.         FDGet TSTRING020(INTEGER011)
  456.     Next
  457.     FClose 1
  458.     STRING019 = TSTRING020(1) + TSTRING020(2)
  459.     STRING019 = Strip(STRING019, " ")
  460.     For INTEGER012 = 1 To Len(STRING019)
  461.         TINTEGER013(INTEGER012) = Asc(Mid(STRING019, INTEGER012, 1))
  462.     Next
  463.     INTEGER009 = 0
  464.     For INTEGER012 = 1 To 99
  465.         INTEGER009 = INTEGER009 + TINTEGER013(INTEGER012)
  466.     Next
  467.     INTEGER010 = INTEGER009 * 659
  468.     INTEGER008 = INTEGER010
  469.     BOOLEAN001 = 0
  470.     If (INTEGER010 <> TSTRING020(3)) Then
  471.         BOOLEAN001 = 0
  472.     Else
  473.         BOOLEAN001 = 1
  474.         STRING014 = TSTRING020(1)
  475.         STRING013 = TSTRING020(2)
  476.     Endif
  477.  
  478.     EndProc
  479.  
  480.  
  481. ;------------------------------------------------------------------------------
  482.  
  483.     Procedure PROC002()
  484.  
  485.     FOpen 1, PPEPath() + "UNI.KEY", 0, 0
  486.     FDefIn 1
  487.     For INTEGER011 = 1 To 3
  488.         FDGet TSTRING020(INTEGER011)
  489.     Next
  490.     FClose 1
  491.     STRING019 = TSTRING020(1) + TSTRING020(2)
  492.     STRING019 = Strip(STRING019, " ")
  493.     For INTEGER012 = 1 To Len(STRING019)
  494.         TINTEGER013(INTEGER012) = Asc(Mid(STRING019, INTEGER012, 1))
  495.     Next
  496.     INTEGER009 = 0
  497.     For INTEGER012 = 1 To 99
  498.         INTEGER009 = INTEGER009 + TINTEGER013(INTEGER012)
  499.     Next
  500.     INTEGER010 = INTEGER009 * 659
  501.     INTEGER008 = INTEGER010
  502.     BOOLEAN001 = 0
  503.     If (INTEGER010 <> TSTRING020(3)) Then
  504.         BOOLEAN001 = 0
  505.     Else
  506.         BOOLEAN001 = 1
  507.         STRING014 = TSTRING020(1)
  508.         STRING013 = TSTRING020(2)
  509.     Endif
  510.  
  511.     EndProc
  512.  
  513.  
  514. ;------------------------------------------------------------------------------
  515.  
  516.     Procedure PROC003()
  517.  
  518.     Cls
  519.     Newlines 4
  520.     PrintLn "@POS:23@@X10┌────────────────────────────────@X19┐@X0F"
  521.     PrintLn "@POS:23@@X10│       @X1ESilent Auction@X1F(tm)       @X19│@X0F"
  522.     PrintLn "@POS:23@@X10└@X19────────────────────────────────┘@X0F"
  523.     PrintLn "@POS:23@@X10┌────────────────────────────────@X19┐@X0F"
  524.     PrintLn "@POS:23@@X10│       @X1FCopyright (c) 1996@X1A       @X19│@X0F"
  525.     PrintLn "@POS:23@@X10│ @X1C────────────────────────────── @X19│@X0F"
  526.     PrintLn "@POS:23@@X10│  @X1BPractical Computer Services   @X19│@X0F"
  527.     PrintLn "@POS:23@@X10│   @X1B @X10   @X1B483 Klockner Road@X10        @X19│@X0F"
  528.     PrintLn "@POS:23@@X10│      @X1BHamilton, NJ  08619@X13       @X19│@X0F"
  529.     PrintLn "@POS:23@@X10│    @X1B   @X10  @X1B(609) 584-7947@X13         @X19│@X0F"
  530.     PrintLn "@POS:23@@X10│                         @X1Ev1.06@X12  @X19│@X0F"
  531.     PrintLn "@POS:23@@X10└@X19────────────────────────────────┘@X0F"
  532.     Delay (5 * 182) / 10
  533.  
  534.     EndProc
  535.  
  536.  
  537. ;------------------------------------------------------------------------------
  538. ;
  539. ; Usage report (before postprocessing)
  540. ;
  541. ; ■ Statements used :
  542. ;
  543. ;    3       End
  544. ;    9       Cls
  545. ;    6       ClrEol
  546. ;    86      Goto 
  547. ;    69      Let 
  548. ;    8       Print 
  549. ;    79      PrintLn 
  550. ;    76      If 
  551. ;    8       DispFile 
  552. ;    6       FOpen 
  553. ;    6       FClose 
  554. ;    3       FGet 
  555. ;    39      FPutLn 
  556. ;    5       Delete 
  557. ;    9       InputStr 
  558. ;    2       Gosub 
  559. ;    3       Return
  560. ;    9       Delay 
  561. ;    1       Inc 
  562. ;    1       Newline
  563. ;    10      Newlines 
  564. ;    7       Backup 
  565. ;    3       Message 
  566. ;    2       FDefIn 
  567. ;    2       FDGet 
  568. ;    3       EndProc
  569. ;    1       EndFunc
  570. ;    1       DOpen 
  571. ;    2       DPack 
  572. ;    2       DCloseAll
  573. ;    1       DnCreate 
  574. ;    1       DNew 
  575. ;    1       DAdd 
  576. ;    3       DTop 
  577. ;    3       DGo 
  578. ;    2       DSkip 
  579. ;    1       DBlank 
  580. ;    2       DDelete 
  581. ;    4       DGet 
  582. ;    30      DPut 
  583. ;
  584. ;
  585. ; ■ Functions used :
  586. ;
  587. ;    10      *
  588. ;    8       /
  589. ;    81      +
  590. ;    9       -
  591. ;    30      ==
  592. ;    18      <>
  593. ;    13      <
  594. ;    10      <=
  595. ;    2       >
  596. ;    23      >=
  597. ;    43      !
  598. ;    22      &&
  599. ;    13      ||
  600. ;    15      Len(
  601. ;    6       Upper()
  602. ;    6       Mid()
  603. ;    7       Left()
  604. ;    4       Asc()
  605. ;    38      Trim()
  606. ;    1       Random()
  607. ;    5       Date()
  608. ;    4       U_Name()
  609. ;    5       Strip()
  610. ;    11      String()
  611. ;    4       Mask_Num()
  612. ;    2       Mask_Ascii()
  613. ;    2       PCBDat()
  614. ;    35      PPEPath()
  615. ;    11      PcbNode()
  616. ;    2       ReadLine()
  617. ;    2       SysopSec()
  618. ;    2       CurSec()
  619. ;    11      Exist()
  620. ;    2       Abs()
  621. ;    22      ToInteger()
  622. ;    3       Mixed()
  623. ;    4       DEof()
  624. ;    9       DRecCount()
  625. ;    3       DRecNo()
  626. ;    66      DGet()
  627. ;
  628. ;------------------------------------------------------------------------------
  629. ;
  630. ; Analysis flags : ds
  631. ;
  632. ; d - Access PCBOARD.DAT ■ 2
  633. ;     Program gets the full pathname to PCBOARD.DAT, this may be usefull
  634. ;     for many PPE so they can find various informations on the system
  635. ;     (system paths, max number of lines in messages, ...) but it may also
  636. ;     be a way to gather vital informations.
  637. ;     ■ Search for : PCBDAT()
  638. ;
  639. ; s - Sysop level access ■ 5
  640. ;     Program is reading the sysop access level, this may be normal
  641. ;     but still it is very suspect. It is the best way to give a user
  642. ;     all priviledges. Check!
  643. ;     ■ Search for : SYSOPSEC()
  644. ;
  645. ;------------------------------------------------------------------------------
  646. ;
  647. ; Postprocessing report
  648. ;
  649. ;    10      For/Next
  650. ;    0       While/EndWhile
  651. ;    28      If/Then or If/Then/Else
  652. ;    0       Select Case
  653. ;
  654. ;------------------------------------------------------------------------------
  655. ;                 AEGiS Corp - Break the routines, code against the machines!
  656. ;------------------------------------------------------------------------------
  657.